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; |
|