Victor_Dobrov
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
#define MyAppName "ISHint Demo Full"
#define MyAppVerName "ISHint 0.5.4.48 by South (htuos)"
#define MyAppPublisher "created by South (htuos)"
[Setup]
AppName={#MyAppName}
AppVerName={#MyAppVerName}
CreateAppDir=false
OutputBaseFilename=ISHintDemoFull
OutputDir=.
[Files]
Source: ISHint.dll; DestDir: {tmp}; Flags: ignoreversion dontcopy
[CustomMessages]
Hint0=Balloon / Без иконки / Без заголовка %nа это вторая строчка 
Hint1=$200|Title 2|Balloon / Без иконки / + Ваш заголовoк %nа это вторая строчка
Hint2=$218|Balloon / + Иконкa / Стандартный заголовок %nа это вторая строчка
Hint3=$100|Классический / Без иконки / Без заголовка %nа это вторая строчка
Hint4=$100|Title|Классический / Без иконки / + Ваш заголовoк %nа это вторая строчка
Hint5=$318|Классический / + Иконкa / Стандартный заголовок %nа это вторая строчка
BackGround=$800|если окно развернуть и перемещать мышь, то мастер скрывается%nклик мышью покажет Мастер
Info=Информация
;6 стиль и размер текста=
;5 цвет фона=
;4 цвет заголовка=
;3 цвет текста=
;2 бит0 - тип хинта=
; $000 - Balloon=
; $100 - classic=
; бит1 - файл иконок=
; $000 - Icons.icl=
; $200 - shell32.dll=
; бит2=
; $000 - без кнопки закрыть=
; $400 - с кнопкой=
; бит3=
; $000 - неподвижный=
; $800 - следовать за мышью=
;1 № иконки=
;0 № иконки / если > 0, то хинт с иконкой=
[Code]
const
DefBackColor = $E3FFFF;
DefTextColor = $000000;
var
i:integer;
r:TRect;
function HintCreate(hControl:THandle; IconIndex:integer; Title,Text:PChar; IsBalloonStyle,WithCloseBtn:boolean):integer; external 'HintCreate@files:ISHint.dll stdcall';
procedure HintShow(X,Y:integer; TimeShow:integer); external 'HintShow@files:ISHint.dll stdcall';
procedure HintRefresh(hControl:THandle); external 'HintRefresh@files:ISHint.dll stdcall';
procedure HintSetParam(hControl:THandle; BackColor,FrameColor:Longint; FontName:PChar; FontSize:integer); external 'HintSetParam@files:ISHint.dll stdcall';
procedure HintSetTextParam(hControl:THandle; Text:PChar; TextColor:Longint; Italic,Underline:boolean); external 'HintSetTextParam@files:ISHint.dll stdcall';
procedure HintSetTitleParam(hControl:THandle; Title:PChar; TitleColor:Longint; Italic,Underline:boolean); external 'HintSetTitleParam@files:ISHint.dll stdcall';
procedure HintSetIcon(hControl:THandle;const IconFileName:PChar; IconIndex:integer); external 'HintSetIcon@files:ISHint.dll stdcall';
procedure HintSetWidth(hControl:THandle; Width:integer); external 'HintSetWidth@files:ISHint.dll stdcall';
procedure HintHide(hControl:THandle); external 'HintHide@files:ISHint.dll stdcall';
procedure HintSetInitTime(hControl:THandle; Time:integer); external 'HintSetInitTime@files:ISHint.dll stdcall';
procedure HintSetShowTime(hControl:THandle; Time:integer); external 'HintSetShowTime@files:ISHint.dll stdcall';
function HintExists(hControl:THandle):boolean; external 'HintExists@files:ISHint.dll stdcall';
procedure HintDelete(hControl:THandle); external 'HintDelete@files:ISHint.dll stdcall';
procedure HintsDestroy; external 'HintsDestroy@files:ISHint.dll stdcall';
function GetClientRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'GetClientRect@user32.dll stdcall';
function GetDesktopWindow: HWND; external 'GetDesktopWindow@user32.dll stdcall';
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
#define BeginColor 170*65536 + 148*256 + 70 ;Blue Green Red
#define FinishColor 180*65536 + 224*256 + 230
type hDC = Longint; TSize = record cx: UINT; cy: UINT; end;
var Point, hPoint: TPoint; CrLf: String; HintLockKey: bool; BackgroundForm: TForm; BackgroundLabel: TLabel; BackgroundImage: TBitmapImage; n: Integer; aRect: TRect; aLabel: TLabel; aText, Capt, st: String;
hHint, sHint: Integer; tHint:string; Panels: array[0..31] of TLabel; Lines: array of String;
const SRCCOPY = $CC0020;
function ShowWindow(hWnd, nCmdShow: LongWord): LongWord; external 'ShowWindow@user32';
function MulDiv(Number, Numerator, Denominator: Integer): Integer; external 'MulDiv@kernel32'; // Умножает Numerator на Number и делит pезультат на Denominator, окpугляя получаемое значение до ближайшего целого. Результат 32767 или -32767, если пеpеполнение или Denominator pавен нулю.
function SetBkMode(DC: hDC; BkMode: Integer): Integer; external 'SetBkMode@gdi32';
procedure GetCursorPos(var Point: TPoint); external 'GetCursorPos@user32 stdcall delayload';
Function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
var Debug: TForm; Dl: TMemo; cDebug: boolean;
Procedure D(S: string); Begin
if not cDebug then begin Debug:= CreateCustomForm; Debug.SetBounds(10, 10, 400, 200) Debug.Show; Dl:=TMemo.Create(Debug); Dl.Align:= alClient; Dl.ScrollBars:= ssVertical; Dl.WantReturns:= False; Dl.Parent:= Debug; cDebug:= true; end;
if Dl.Lines.Text = '' then Dl.Lines.Text:= S else Dl.Lines.Insert(Dl.Lines.Count, S); Debug.BringToFront
End;
Procedure Df(s: Extended); begin D(FloatToStr(s)) End;
Function RGB(r, g, b: Longint): Longint; Begin Result:= (r or (g shl 8) or (b shl 16)) End;
Function GetBValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 16) End;
Function GetGValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 8) End;
Function GetRValue(rgb: DWord): Byte; Begin Result:= Byte(rgb) End;
Procedure GradientFill(WorkBmp: TBitmapImage; BeginColor, FinishColor: TColor); var ColorBand: TRect; Begin
WorkBmp.Bitmap.Width:= WorkBmp.Width; WorkBmp.Bitmap.Height:= WorkBmp.Height;
n:= 255; for i:=0 to n do begin
ColorBand.Right:= WorkBmp.Width; ColorBand.Top:= MulDiv(i, WorkBmp.Height, n); ColorBand.Bottom:= MulDiv(i+1, WorkBmp.Height, n);
WorkBmp.Bitmap.Canvas.Brush.Color:= RGB(GetRValue(BeginColor) + MulDiv(I, GetRValue(FinishColor) - GetRValue(BeginColor), n-1), GetGValue(BeginColor) + MulDiv(I, GetGValue(FinishColor) - GetGValue(BeginColor), n-1), GetBValue(BeginColor) + MulDiv(I, GetBValue(FinishColor) - GetBValue(BeginColor), n-1));
WorkBmp.Bitmap.Canvas.FillRect(ColorBand); end;
End;
Function StringToArray(Text, Cut: String): array of String; var t, i, k: Integer; Begin {создать массив из текста}
SetArrayLength(Result, 0);
Repeat SetArrayLength(Result, GetArrayLength(Result) + 1); t:= 1; k:= Pos(Cut, Text);
if k > 0 then t:= Length(Cut) {else k:= Pos(#10, Text);} i:= GetArrayLength(Result) - 1;
if k > 0 then begin Result[i]:= Copy(Text, 1, k - 1); Text:= Copy(Text, k + t, Length(Text)) end else begin Result[i]:=Text; SetLength(Text, 0) end;
Until Length(Text) = 0;
End;
Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer): TLabel; var tmpLabel: TLabel; Begin
tmpLabel:=TLabel.Create(Parent)
if Top > 0 then tmpLabel.Top:=Top; if Left > 0 then tmpLabel.Left:= Left; if Width > 0 then tmpLabel.Width:= Width; if Height > 0 then tmpLabel.Height:= Height
tmpLabel.AutoSize:= AutoSize; tmpLabel.WordWrap:= WordWrap; tmpLabel.Transparent:=Transparent; tmpLabel.ShowHint:= 0 = {#Defined(ImprovedHints)}
if FontName <> '' then tmpLabel.Font.Name:= FontName; if FontColor > 0 then tmpLabel.Font.Color:= FontColor; if FontStyle <> [] then tmpLabel.Font.Style:= FontStyle
tmpLabel.Parent:= Parent; Result:= tmpLabel
End;
Function TextOnBitmap(Bmp: TBitmapImage; Text, FontName: String; Style, Left, Top, Bevel, Size, Between: Integer; Color, Back: TColor): TRect; var X, Y, tWidth, tHeight: Integer; Messages: array of String; Begin {позицию текста указывать в процентах}
Messages:= StringToArray(Text, CrLf); with Bmp.Bitmap.Canvas do begin
Font.Name:= FontName; case Style of 1: Font.Style:= [fsBold]; 2: Font.Style:= [fsItalic]; 3: Font.Style:= [fsBold, fsItalic]; end;
SetBkMode(Handle, 1); Font.Height:= round((Bmp.Width+Bmp.Height)/1000*Size) // попытка подстроить шрифт под размер окна 
for n:= 0 to GetArrayLength(Messages) -1 do begin
if TextWidth(Messages[n]) > tWidth then tWidth:= TextWidth(Messages[n])
tHeight:= tHeight + Between + TextHeight(Messages[n]) {! при разных стилях текста значения не меняются}
if Bmp.Width/100*Left + tWidth + TextWidth(' ') > Bmp.Width then X:= Bmp.Width - tWidth - TextWidth(' ') else X:= Bmp.Width/100*Left;
if Bmp.Height/100*Top + tHeight + Between + TextHeight(' ')/2 > Bmp.Height then Y:= Bmp.Height - tHeight - Between - TextHeight(' ')/2 else Y:= Bmp.Height/100*Top;
end; Result.Left:= X; Result.Top:= Y; Result.Right:= tWidth; Result.Bottom:= tHeight
for n:= 0 to GetArrayLength(Messages) -1 do begin
Font.Color:= Back; TextOut(X, Y + Font.Height*n + Between*n, Messages[n]);
Font.Color:= Color; TextOut(X - Bevel, Y - Bevel + Font.Height*n + Between*n, Messages[n]); end;
end; End;
Procedure BackgroundClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
WizardForm.Visible:= not(WizardForm.Visible) if WizardForm.Visible then WizardForm.Show;
End;
Procedure BackgroundOnResize(Sender: TObject); var Font, iFont: String; Left, Top, Size, Style: Byte; Color, Color2: TColor; Begin
GradientFill(BackgroundImage, {#BeginColor}, {#FinishColor});
Left:= 50; Top:= 95; Font:= 'Times'; Size:= 18; Style:= 3; Color:= $C0A070; Color2:= $302818;
TextOnBitmap(BackgroundImage, WizardForm.Caption, Font, Style, Left, Top, 1, Size, 0, Color, Color2);
End;
Procedure GetStyle(Text: String; var hText, hTitle, IconFile: String; var Style: Integer);
Begin
Lines:= StringToArray(Text,'|'); hText:= Lines[GetArrayLength(Lines)-1] {last text}
Style:= StrToIntDef(Lines[0], 0); if GetArrayLength(Lines) > 1 then
if (Style > 0) and (GetArrayLength(Lines) = 2) then hTitle:= '' else hTitle:= Lines[GetArrayLength(Lines)-2] {prev of last}
if Style and $200 > 0 then IconFile:= ExpandConstant('{sys}\shell32.dll')
if (Style and $FF > 0) {иконка} and (GetArrayLength(Lines) = 2) {но заголовок не указан} then hTitle:= cm('Info')
End;
Function GetHintColor(Color: Integer): Integer; Begin
case Color and $F000 shr 12 of
0: result:= clBlack
1: result:= clBlue
2: result:= $D0 //red
3: result:= clGreen
4: result:= clNavy
5: result:= clPurple
6: result:= clMaroon
7: result:= clGray
End; end;
Function SetHintStyle(Text: String; Color: Integer): String; var Style: Integer; Begin
Result:= Text; Lines:= StringToArray(Text,'|');
Style:= StrToIntDef(Lines[0], 0) and $FFF + Color * $1000
Delete(Result, 1, (Length(Lines[0]) +1) * ord(StrToIntDef(Lines[0], 0) > 0));
Result:= IntToStr(Style) +'|'+ Result
End;
Procedure NowHint(Sender: TObject; Text: String); var hText, hTitle, IconFile: String; Handle, Style: Integer; fast: Boolean; Begin {hPoint - позиция свободного хинта}
if Sender <> Nil then begin Handle:=TWinControl(Sender).Handle; GetCursorPos(Point) end else Handle:= 0;
if (hHint = Handle) and (tHint = Text) and (hPoint.X = Point.X) and (hPoint.Y = Point.Y) then Exit; {данные не изменились}
if HintLockKey then begin HintLockKey:= false Exit; end; {выйти, если предыдущий хинт был свободный}
if HintExists(hHint) and (hHint <> Handle) then HintDelete(hHint) {удалить старый хинт}
GetStyle(Text, hText, hTitle, IconFile, Style); {раскодирование строки вида $105|Название|Текст}
fast:= (Handle <> 0) and ((Point.X > hPoint.X+1) or (Point.X < hPoint.X-1) or (Point.Y > hPoint.Y+1) or (Point.Y < hPoint.Y-1))
if fast and (Style and $800 = 0) or (tHint <> Text) and HintExists(Handle) then HintDelete(Handle) {текст изменился / мышь быстро перемещают}
if not fast and not HintExists(Handle) then begin
HintCreate(Handle, ord(Style and $FF > 0), hTitle, hText, Style and $100 = 0, Style and $400 > 0);
if Handle > 0 then HintSetInitTime(Handle, 500)
HintSetWidth(Handle, WizardForm.ClientWidth - 32);
if Style and $FF > 0 then HintSetIcon(Handle, IconFile, Style and $FF -1) {с иконкой}
HintSetTitleParam(Handle, hTitle, -1, false, false);
HintSetTextParam(Handle, hText, GetHintColor(Style and $F000), false, false);
end else if Style and $800 > 0 then HintRefresh(Handle) {следовать за мышью}
if Handle = 0 then HintShow(Point.X+2, Point.Y+2, Length(Text)/15)
hHint:= Handle; tHint:=Text; hPoint:= Point; HintLockKey:= hHint = 0; {не показывать новый хинт сразу после свободного}
End;
Procedure LabelOnShot(Sender: TObject; Shift: TShiftState; X, Y: Integer); Begin
NowHint(TControl(Sender).Parent, TLabel(Sender).Hint);
// df(x)
End;
Procedure DelHints(Sender: TObject; Shift: TShiftState; X, Y: Integer); Begin
if HintExists(hHint) then HintDelete(hHint); hHint:= 0; tHint:='';
End;
procedure AddSamples; begin
WizardForm.OuterNotebook.Hide; WizardForm.Bevel.Hide; CrLf:= #13#10;
Panels[0]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 190, 190, 70, 30)
Panels[0].Hint:= cm('Hint0')
Panels[0].Caption:= 'Time'
Panels[0].Color:= clWhite
// Panels[0].ShowHint:= true
Panels[0].OnMouseMove:= @LabelOnShot;
Panels[1]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 270, 190, 70, 30)
Panels[1].Hint:= cm('Hint1')
Panels[1].Color:= clWhite
// Panels[1].ShowHint:= true
Panels[1].OnMouseMove:= @LabelOnShot;
Panels[2]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 350, 190, 70, 30)
Panels[2].Hint:= cm('Hint2')
Panels[2].Color:= clWhite
// Panels[2].ShowHint:= true
Panels[2].OnMouseMove:= @LabelOnShot;
Panels[3]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 190, 230, 70, 30)
Panels[3].Hint:= cm('Hint3')
Panels[3].Color:= clWhite
// Panels[3].ShowHint:= true
Panels[3].OnMouseMove:= @LabelOnShot;
Panels[4]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 270, 230, 70, 30)
Panels[4].Hint:= cm('Hint4')
Panels[4].Color:= clWhite
// Panels[4].ShowHint:= true
Panels[4].OnMouseMove:= @LabelOnShot;
Panels[5]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 350, 230, 70, 30)
Panels[5].Color:= clWhite
Panels[5].Hint:= cm('Hint5')
// Panels[5].ShowHint:= true
Panels[5].OnMouseMove:= @LabelOnShot;
Panels[6]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 190, 270, 230, 30)
Panels[6].Color:= clWhite
Panels[6].Caption:= 'Скрыть все хинты (сброс)'
// Panels[5].ShowHint:= true
Panels[6].OnMouseMove:= @DelHints;
Panels[7]:= CreateLabel(WizardForm, false, false, false, '', [], 0, 190, 150, 230, 30)
Panels[7].Color:= clWhite
Panels[7].Caption:= 'Скрыть все хинты (сброс)'
// Panels[5].ShowHint:= true
Panels[7].OnMouseMove:= @DelHints;
BackgroundForm:=TForm.Create(WizardForm)
// BackgroundForm.BorderStyle:= bsNone
// BackgroundForm.OnActivate:= @BackgroundOnActivate;
BackgroundImage:= TBitmapImage.Create(BackgroundForm);
BackgroundImage.Align:= alClient; // BackgroundImage.Enabled:= False;
BackgroundImage.Parent:= BackgroundForm;
BackgroundForm.OnResize:= @BackgroundOnResize;
BackgroundLabel:= CreateLabel(BackgroundForm, false, false, true, '', [], 0, 0, 0, BackgroundForm.Width, BackgroundForm.Height)
BackgroundLabel.OnMouseMove:= @LabelOnShot;
BackgroundLabel.Hint:= cm('BackGround')
BackgroundLabel.OnMouseUp:= @BackgroundClick;
// CreateHint(BackgroundForm, '', BackgroundLabel.Hint, 0); //иначе при первом показе хинта окно мастера скрывается
ShowWindow(BackgroundForm.Handle, SW_SHOWNORMAL) // фоновое окно на полный экран
end;
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure InitializeWizard;
begin
AddSamples
end;
procedure DeInitializeSetup;
begin
HintsDestroy; //это обязательно для освобождения памяти
BackgroundForm.Free;
end;
|
|
